home *** CD-ROM | disk | FTP | other *** search
/ Aminet 37 / Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso / Aminet / dev / misc / numconv.lha / numconv.e next >
Encoding:
Text File  |  2000-03-30  |  8.2 KB  |  295 lines
  1. /* E Source generated by SRCGEN v0.4 */
  2.  
  3. OPT OSVERSION=37,REG=5
  4.  
  5. MODULE 'gadtools',
  6.        'libraries/gadtools',
  7.        'intuition/intuition',
  8.        'intuition/screens',
  9.        'intuition/gadgetclass',
  10.        'intuition/iobsolete',
  11.        'utility/tagitem',
  12.        'devices/inputevent',
  13.        'graphics/text',
  14.        'tools/detatch'
  15.  
  16. ENUM ERROR_NONE,
  17.      ERROR_CONTEXT,
  18.      ERROR_GADGET,
  19.      ERROR_WB,
  20.      ERROR_VISUAL,
  21.      ERROR_GT,
  22.      ERROR_WINDOW,
  23.      ERROR_MENUS
  24.  
  25. ENUM G_SRC,G_DST,G_STR,G_TXT,G_CB
  26. ENUM DECI,HEX,BIN,ASCII,FLOAT,OCTAL
  27.  
  28. DEF infos:PTR TO gadget,
  29.     wnd:PTR TO window,
  30.     glist,
  31.     scr:PTR TO screen,
  32.     visual=NIL,
  33.     tattr:PTR TO textattr,
  34.     id
  35. DEF gsrc,gdst,gs,gt,gcb
  36. DEF src,dst,str:PTR TO CHAR,txt[36]:STRING,num,error=FALSE
  37.  
  38. PROC setupscreen()
  39.     IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN ERROR_GT
  40.     IF (scr:=LockPubScreen('Workbench'))=NIL THEN RETURN ERROR_WB
  41.     IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN RETURN ERROR_VISUAL
  42.     tattr:=scr.font
  43. ENDPROC
  44.  
  45. CHAR '$VER: NumConv v1.5 by MarK (30.3.2000), kuchinka@volny.cz',0
  46.  
  47. PROC closedownscreen()
  48.     IF visual THEN FreeVisualInfo(visual)
  49.     IF scr THEN UnlockPubScreen(NIL,scr)
  50.     IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  51. ENDPROC
  52.  
  53. PROC openwindow()
  54.   DEF g:PTR TO gadget
  55.   IF (g:=CreateContext({glist}))=NIL THEN RETURN ERROR_CONTEXT
  56.   IF (gsrc:=CreateGadgetA(CYCLE_KIND,g,
  57.     [4,4,85,21,NIL,tattr,G_SRC,$0,visual,0]:newgadget,
  58.     [GTCY_LABELS,['DEC','HEX','BIN','ASCII','FLOAT','OCTAL',0],
  59.      GTCY_ACTIVE,DECI,
  60.      TAG_END]))=NIL THEN RETURN ERROR_GADGET
  61.   IF (gdst:=CreateGadgetA(CYCLE_KIND,gsrc,
  62.     [4,28,85,21,NIL,tattr,G_DST,$0,visual,0]:newgadget,
  63.     [GTCY_LABELS,['DEC','HEX','BIN','ASCII','FLOAT','OCTAL',0],
  64.      GTCY_ACTIVE,HEX,
  65.      TAG_END]))=NIL THEN RETURN ERROR_GADGET
  66.   IF (gs:=CreateGadgetA(STRING_KIND,gdst,
  67.     [92,4,245,21,NIL,tattr,G_STR,$0,visual,0]:newgadget,
  68.     [GTST_MAXCHARS,34,
  69.      TAG_END]))=NIL THEN RETURN ERROR_GADGET
  70.   IF (gt:=CreateGadgetA(TEXT_KIND,gs,
  71.     [92,28,269,21,NIL,tattr,G_TXT,$0,visual,0]:newgadget,
  72.     [GTTX_BORDER,TRUE,
  73.      TAG_END]))=NIL THEN RETURN ERROR_GADGET
  74.   IF (gcb:=CreateGadgetA(BUTTON_KIND,gt,
  75.     [340,4,21,21,'CB',tattr,G_CB,$0,visual,0]:newgadget,NIL))=NIL THEN RETURN ERROR_GADGET
  76.   IF (wnd:=OpenWindowTagList(NIL,
  77.     [WA_LEFT,0,
  78.      WA_TOP,scr.barheight+1,
  79.      WA_INNERWIDTH,364,
  80.      WA_INNERHEIGHT,52,
  81.      WA_IDCMP,IDCMP_GADGETUP OR IDCMP_GADGETDOWN OR IDCMP_CLOSEWINDOW OR IDCMP_ACTIVEWINDOW OR IDCMP_CHANGEWINDOW OR IDCMP_MOUSEBUTTONS,
  82.      WA_FLAGS,WFLG_CLOSEGADGET OR WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_GIMMEZEROZERO OR WFLG_ACTIVATE OR WFLG_RMBTRAP,
  83.      WA_TITLE,'NumConv v1.5 by Martin Kuchinka',
  84.      WA_SCREENTITLE,'NoTek 2000',
  85.      WA_CUSTOMSCREEN,scr,
  86.      WA_AUTOADJUST,TRUE,
  87.      WA_GADGETS,glist,
  88.      TAG_END]))=NIL THEN RETURN ERROR_WINDOW
  89.   Gt_RefreshWindow(wnd,NIL)
  90. ENDPROC
  91.  
  92. PROC closewindow()
  93.   IF wnd THEN CloseWindow(wnd)
  94.   IF glist THEN FreeGadgets(glist)
  95. ENDPROC
  96.  
  97. PROC process(win:PTR TO window)
  98.   DEF type=0
  99.   ActivateGadget(gs,win,NIL)
  100.   REPEAT
  101.     type:=wait4message(win)
  102.     SELECT type
  103.     CASE IDCMP_CLOSEWINDOW;    RETURN
  104.     CASE IDCMP_MOUSEBUTTONS
  105.       ActivateGadget(gs,win,NIL)
  106.     CASE IDCMP_GADGETUP
  107.      go:
  108.       Gt_GetGadgetAttrsA(gsrc,win,NIL,[GTCY_ACTIVE,{src},TAG_END])
  109.       Gt_GetGadgetAttrsA(gdst,win,NIL,[GTCY_ACTIVE,{dst},TAG_END])
  110.       Gt_GetGadgetAttrsA(gs,win,NIL,[GTST_STRING,{str},TAG_END])
  111.       IF id=G_CB
  112.         Gt_SetGadgetAttrsA(gs,win,NIL,[GTST_STRING,txt,TAG_END])
  113.         Gt_GetGadgetAttrsA(gs,win,NIL,[GTST_STRING,{str},TAG_END])
  114.         ENDIF
  115.       SELECT dst
  116.       CASE DECI
  117.         SELECT src
  118.         CASE DECI; StringF(txt,'\d',Val(str))
  119.         CASE HEX;  StringF(txt,'$\s',str); num:=Val(txt); StringF(txt,'\d',num)
  120.         CASE BIN;  StringF(txt,'\d',bin2num(str))
  121.         CASE ASCII;StringF(txt,'\d',ascii2num(str))
  122.         CASE FLOAT;StringF(txt,'\d',RealVal(str))
  123.         CASE OCTAL;StringF(txt,'\d',readoct(str))
  124.         ENDSELECT
  125.       CASE HEX
  126.         SELECT src
  127.         CASE DECI; StringF(txt,'\h',Val(str))
  128.         CASE HEX;  StringF(txt,'$\s',str); num:=Val(txt); StringF(txt,'\h',num)
  129.         CASE BIN;  StringF(txt,'\h',bin2num(str))
  130.         CASE ASCII;StringF(txt,'\h',ascii2num(str))
  131.         CASE FLOAT;StringF(txt,'\h',RealVal(str))
  132.         CASE OCTAL;StringF(txt,'\h',readoct(str))
  133.         ENDSELECT
  134.       CASE BIN
  135.         SELECT src
  136.         CASE DECI; num2bin(txt,Val(str))
  137.         CASE HEX;  StringF(txt,'$\s',str); num2bin(txt,Val(txt))
  138.         CASE BIN;  num2bin(txt,bin2num(str))
  139.         CASE ASCII;num2bin(txt,ascii2num(str))
  140.         CASE FLOAT;num2bin(txt,RealVal(str))
  141.         CASE OCTAL;num2bin(txt,readoct(str))
  142.         ENDSELECT
  143.       CASE ASCII
  144.         SELECT src
  145.         CASE DECI; num2ascii(txt,Val(str))
  146.         CASE HEX;  StringF(txt,'$\s',str); num2ascii(txt,Val(txt))
  147.         CASE BIN;  num2ascii(txt,bin2num(str))
  148.         CASE ASCII;num2ascii(txt,ascii2num(str))
  149.         CASE FLOAT;num2ascii(txt,RealVal(str))
  150.         CASE OCTAL;num2ascii(txt,readoct(str))
  151.         ENDSELECT
  152.       CASE FLOAT
  153.         SELECT src
  154.         CASE DECI; RealF(txt,Val(str),6)
  155.         CASE HEX;  StringF(txt,'$\s',str); RealF(txt,Val(txt),6)
  156.         CASE BIN;  RealF(txt,bin2num(str),6)
  157.         CASE ASCII;RealF(txt,ascii2num(str),6)
  158.         CASE FLOAT;RealF(txt,RealVal(str),6)
  159.         CASE OCTAL;RealF(txt,readoct(str),6)
  160.         ENDSELECT
  161.       CASE OCTAL
  162.         SELECT src
  163.         CASE DECI; writeoct(txt,Val(str))
  164.         CASE HEX;  StringF(txt,'$\s',str); writeoct(txt,Val(txt))
  165.         CASE BIN;  writeoct(txt,bin2num(str))
  166.         CASE ASCII;writeoct(txt,ascii2num(str))
  167.         CASE FLOAT;writeoct(txt,RealVal(str))
  168.         CASE OCTAL;writeoct(txt,readoct(str))
  169.         ENDSELECT
  170.       ENDSELECT
  171.       IF error=FALSE THEN Gt_SetGadgetAttrsA(gt,win,NIL,[GTTX_TEXT,txt,TAG_END])
  172.       error:=FALSE
  173.       ActivateGadget(gs,win,NIL)
  174.     DEFAULT;        JUMP go
  175.     ENDSELECT
  176.   UNTIL type=IDCMP_CLOSEWINDOW
  177. ENDPROC
  178.  
  179. PROC wait4message(win:PTR TO window)
  180.   DEF mes:PTR TO intuimessage,type
  181.   REPEAT
  182.     type:=0
  183.     IF mes:=Gt_GetIMsg(win.userport)
  184.       type:=mes.class
  185.       IF type=IDCMP_GADGETUP
  186.         infos:=mes.iaddress
  187.         id:=infos.gadgetid
  188.       ENDIF
  189.       Gt_ReplyIMsg(mes)
  190.     ELSE
  191.       WaitPort(win.userport)
  192.     ENDIF
  193.   UNTIL type
  194. ENDPROC type
  195.  
  196. PROC reporterr(er)
  197.   DEF erlist:PTR TO LONG
  198.   IF er
  199.     erlist:=['get context',
  200.              'create gadget',
  201.              'lock wb',
  202.              'get visual infos',
  203.              'open "gadtools.library" v37+',
  204.              'open window',
  205.              'create menus']
  206.     EasyRequestArgs(0,[20,0,0,'Could not \s!','OK'],0,[erlist[er-1]])
  207.   ENDIF
  208. ENDPROC er
  209.  
  210. PROC main() HANDLE
  211.   detatch('NumConv')
  212.   IF reporterr(setupscreen())=0
  213.     reporterr(openwindow())
  214.     process(wnd)
  215.     closewindow()
  216.     IF CtrlC() THEN Raise(ERROR_NONE)
  217.   ENDIF
  218.   Raise(ERROR_NONE)
  219. EXCEPT
  220.   closedownscreen()
  221. ENDPROC
  222.  
  223. PROC bin2num(str:PTR TO CHAR)
  224.     DEF num=0,n=0
  225.     WHILE str[n]="0" DO n++
  226.     WHILE str[n]
  227.         IF str[n]="0";            num:=Shl(num,1)
  228.         ELSEIF str[n]="1";    num:=Shl(num,1) OR 1
  229.         ELSE
  230.             Gt_SetGadgetAttrsA(gt,wnd,NIL,[GTTX_TEXT,'Illegal Character',TAG_END])
  231.             error:=TRUE
  232.         ENDIF
  233.         n++
  234.     ENDWHILE
  235. ENDPROC num
  236.  
  237. PROC ascii2num(str:PTR TO CHAR)
  238.     DEF num,s=0
  239.     num:=^str
  240.     IF (num AND $00ff0000)=0 THEN s:=3 ELSE IF (num AND $0000ff00)=0 THEN s:=2 ELSE IF (num AND $000000ff)=0 THEN s:=1
  241.     num:=Shr(num,s*8)
  242. ENDPROC num
  243.  
  244. PROC num2bin(txt:PTR TO CHAR,num)
  245.     DEF n=31,i=0
  246.     WHILE n+1
  247.         txt[i]:=IF num AND Shl(1,n) THEN "1" ELSE "0"
  248.         n--
  249.         i++
  250.     ENDWHILE
  251.     txt[i]:=0
  252. ENDPROC
  253.  
  254. PROC num2ascii(txt:PTR TO CHAR,num)
  255.     DEF n
  256.     IF num<=$ff;    num:=Shl(num,24)
  257.     ELSEIF num<=$ffff;    num:=Shl(num,16)
  258.     ELSEIF num<=$ffffff;    num:=Shl(num,8)
  259.     ENDIF
  260.     ^txt:=num
  261.     txt[4]:=0
  262.     FOR n:=0 TO 3
  263.         IF ((txt[n]>="\0") AND (txt[n]<" ")) OR ((txt[n]>=128) AND (txt[n]<160)) THEN txt[n]:="."
  264.     ENDFOR
  265. ENDPROC
  266.  
  267. PROC readoct(txt:PTR TO CHAR)
  268.     DEF    n=0,num=0
  269.     WHILE txt[n]
  270.         IF (txt[n]>="0") AND (txt[n]<="7")
  271.             num:=Shl(num,3)
  272.             num:=num OR (txt[n] AND $7)
  273.         ELSE
  274.             Gt_SetGadgetAttrsA(gt,wnd,NIL,[GTTX_TEXT,'Illegal Character',TAG_END])
  275.             error:=TRUE
  276.         ENDIF
  277.         n++
  278.     EXIT n=12
  279.     ENDWHILE
  280. ENDPROC num
  281.  
  282. PROC writeoct(txt:PTR TO CHAR,num)
  283.     DEF n,m,i=0
  284.     FOR n:=0 TO 10
  285.         IF num AND Shl(7,n*3) THEN m:=n
  286.     ENDFOR
  287.  
  288.     WHILE m+1
  289.         txt[i]:=(Shr(num,m*3) AND 7)+"0"
  290.         i++
  291.         m--
  292.     ENDWHILE
  293.     txt[i]:=0
  294. ENDPROC num
  295.